
Sub SetImg8x12_SEQ()
    Dim shp As Shape
    Dim inShp As InlineShape
    Dim rng As Range
    Dim fld As Field
    Dim doc As Document
    Dim legendRange As Range
    
    Set doc = ActiveDocument
    
    ' 1. 找到选中的图片（嵌入或浮动）
    If Selection.InlineShapes.Count > 0 Then
        Set inShp = Selection.InlineShapes(1)
        ' 为便于调整尺寸，先转换成 Shape（浮动）
        Set shp = inShp.ConvertToShape
    ElseIf Selection.ShapeRange.Count > 0 Then
        Set shp = Selection.ShapeRange(1)
    Else
        MsgBox "请先选中一张图片再运行此宏！", vbExclamation
        Exit Sub
    End If
    
    ' 2. 解除锁定纵横比并设置尺寸（12cm x 8cm，1cm = 28.35 pts）
    On Error Resume Next
    shp.LockAspectRatio = msoFalse
    On Error GoTo 0
    shp.Width = 12 * 28.35
    shp.Height = 8 * 28.35
    
    ' 3. 转为嵌入式图片（InlineShape）
    Set inShp = shp.ConvertToInlineShape
    
    ' 4. 使图片所在段落居中
    Set rng = inShp.Range
    rng.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
    ' 5. 在图片下方插入一个新段落，并在该段落中插入 SEQ 域（域名为"图"）
    '    结果显示形式为：图1 （域前带上"图"文字，通过域前文本与域结合）
    rng.Collapse Direction:=wdCollapseEnd
    rng.InsertParagraphAfter
    ' 获取新插入的段落的 Range
    Set legendRange = rng.Paragraphs(1).Next.Range
    ' 清空该 Range 的文本，确保干净
    legendRange.Text = ""
    ' 将段落居中
    legendRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
    ' 插入前置文字 "图"（这部分是静态文字），后插入 SEQ 域
    legendRange.InsertAfter "图"
    ' 将光标移到文字后面以插入域
    legendRange.Collapse Direction:=wdCollapseEnd
    ' 插入 SEQ 域：域代码为 SEQ 图 \* ARABIC（阿拉伯数字）
    Set fld = doc.Fields.Add(Range:=legendRange, Type:=wdFieldEmpty, Text:="SEQ 图 \* ARABIC", PreserveFormatting:=False)
    ' 可选：设置编号后面的格式（例如不加点），如果需要可在文字后再插入空格或其他字符
    ' 例如在编号后添加一个句点： legendRange.InsertAfter "。"
    
    ' 设置图例字体大小（可调整）
    legendRange.Font.Size = 10
    
    ' 6. 更新文档所有域（确保编号即时显示）
    On Error Resume Next
    doc.Fields.Update
    On Error GoTo 0

End Sub



Sub SetImg4x7_SEQ()
    Dim shp As Shape
    Dim inShp As InlineShape
    Dim rng As Range
    Dim fld As Field
    Dim doc As Document
    Dim legendRange As Range
    
    Set doc = ActiveDocument
    
    ' 1. 找到选中的图片（嵌入或浮动）
    If Selection.InlineShapes.Count > 0 Then
        Set inShp = Selection.InlineShapes(1)
        ' 为便于调整尺寸，先转换成 Shape（浮动）
        Set shp = inShp.ConvertToShape
    ElseIf Selection.ShapeRange.Count > 0 Then
        Set shp = Selection.ShapeRange(1)
    Else
        MsgBox "请先选中一张图片再运行此宏！", vbExclamation
        Exit Sub
    End If
    
    ' 2. 解除锁定纵横比并设置尺寸（7cm x 4cm，1cm = 28.35 pts）
    On Error Resume Next
    shp.LockAspectRatio = msoFalse
    On Error GoTo 0
    shp.Width = 7 * 28.35
    shp.Height = 4 * 28.35
    
    ' 3. 转为嵌入式图片（InlineShape）
    Set inShp = shp.ConvertToInlineShape
    
    ' 4. 使图片所在段落居中
    Set rng = inShp.Range
    rng.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
    
    ' 6. 更新文档所有域（确保编号即时显示）
    On Error Resume Next
    doc.Fields.Update
    On Error GoTo 0

End Sub


Sub UpdateTOCOnly()
    Dim toc As TableOfContents
    Dim countUpdated As Integer
    
    countUpdated = 0
    
    ' 遍历文档中的所有目录（一般只有一个）
    For Each toc In ActiveDocument.TablesOfContents
        toc.Update   ' 更新目录页
        countUpdated = countUpdated + 1
    Next toc
    
    If countUpdated = 0 Then
        MsgBox "当前文档中没有发现目录。", vbExclamation
    Else
        MsgBox "目录已更新完成。", vbInformation
    End If
End Sub

Sub ReplaceAtWithArrayItems()
    Dim arrTexts As Variant
    Dim i As Long
    Dim findRange As Range
    Dim txt As String
    Dim padCount As Long
    Dim j As Long

    ' 定义要替换的内容数组
    arrTexts = Array( _
        "无人机实训室（1）", "无人机实训室（2）", "计算机检测维修与数据恢复实训室", "计算机芯片维修实训室", _
        "计算机组装实训室", "编程实训室", "电商实训室一", "电商实训室二", "联想备件库", "联想接待室", _
        "联想PC+实训室", "联想服务器实训室", "公共综合计算机室（1）", "公共综合计算机室（2）", "公共综合计算机室（3）", _
        "公共综合计算机室（4）", "公共综合计算机室（5）", "公共综合计算机室（6）", "公共综合计算机室（7）", _
        "公共综合计算机室（8）", "公共综合计算机室（9）", "公共综合计算机室（10）", "公共综合计算机室（11）", _
        "公共综合计算机室（12）", "公共综合计算机室（13）", "公共综合计算机室（14）", "公共综合计算机室（15）", _
        "公共综合计算机室（16）", "公共综合计算机室（17）", "公共综合计算机室（18）", "邮政安检机房（一）", _
        "邮政安检机房（二）", "航空安检（1）", "航空安检（2）", "邮政安检（1）", "邮政安检（2）", _
        "形体房（1）", "形体房（2）", "微格教室（6）", "礼仪实训室", "航空模拟机舱", "中餐实训室", _
        "客房实训室", "西餐实训室", "茶艺实训室", "航空服务模拟订票、值机实训室", "陶艺室", "影视后期", _
        "图文创作室", "平面设计（204）", "动画制作（202）", "游戏美术（1）（218）", "游戏美术", _
        "游戏大专机房（1）", "上海那弩企业工作室", "张家口塞上文化传媒工作室", "动画工作室（510）", "画室（1）", _
        "游戏美术3（206）", "枫动动画工作室（218）", "游戏大专机房2（310）", "公共机房", "数码钢琴室（1）", _
        "数码钢琴室（2）", "钢琴室（1）", "声乐合唱", "民乐实训室", "琵琶实训室", "管乐实训室", "美术手工", _
        "蒙氏奥尔夫亲子实训室", "舞蹈房（1）", "舞蹈房（2）", "舞蹈房（3）", "舞蹈房（4）", "微格教室（1）", _
        "智能电钢实训室", "幼儿保育护理实训室", "西点", "西餐基础实训室", "西餐热炒实训室（1）", _
        "西餐热炒实训室（2）", "中式面点", "中餐热炒实训室（1）", "中餐热炒实训室（2）", "中餐刀工室", _
        "中西餐多功能演播室", "烹饪原料室", "大赛集训室", "烹调学生更衣室", "体育馆", "体能训练厅", _
        "演出厅", "服装展室", "美术展厅", "精品录播教室1", "精品录播室（1）", "精品录播教室2", "心理咨询室", "心理健康室")

    i = 0
    Set findRange = ActiveDocument.Content

    ' 循环查找每一个＠并依次替换
    With findRange.Find
        .ClearFormatting
        .Text = "＠"
        .Forward = True
        .Wrap = wdFindStop
        
        Do While .Execute
            If i > UBound(arrTexts) Then Exit Do ' 防止超出数组
            
            txt = arrTexts(i)
            
            ' === 计算前置空格数量 ===
            padCount = (60 - Len(txt)) / 2
            If padCount < 0 Then padCount = 0 ' 避免负数
            
            ' 拼接前置空格
            For j = 1 To padCount
                txt = " " & txt
            Next j
            
            ' 替换＠
            findRange.Text = txt
            
            i = i + 1
            findRange.Collapse Direction:=wdCollapseEnd ' 继续往后找
        Loop
    End With

    MsgBox "替换完成，共替换 " & i & " 处＠。", vbInformation
End Sub


Sub 增加题注()
'
' 增加题注 Macro
' 宏由 Administrator 录制，时间: 2025/10/16
'

    ActiveWindow.ActivePane.Activate
    Application.Browser.Previous
    Selection.InsertCaption Label:="表", Title:=" 设备清单", TitleAutoText:="", Position:=wdCaptionPositionAbove, ExcludeLabel:=False
End Sub

Sub replace_pp()
'
' replace_pp Macro
' 宏由 Administrator 录制，时间: 2023/09/28
'

'
    Selection.Find.Wrap = wdFindAsk
    Selection.Find.Wrap = wdFindAsk
    With Selection.Find
        .Text = "^p^p"
        .Forward = True
        .Wrap = wdFindAsk
        .MatchCase = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchWholeWord = False
        .MatchFuzzy = False
        .Replacement.Text = "^p"
    End With
    With Selection.Find
        .Style = ""
        .Highlight = wdUndefined
        With .Replacement
            .Style = ""
            .Highlight = wdUndefined
        End With
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Replacement.Text = "^p"
End Sub
